perm filename MOTIV.F4[SCR,LCS] blob sn#365862 filedate 1978-07-07 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002
C00004 ENDMK
C⊗;

C≡≡≡≡≡≡ THIS IS THE REQUIRED HEADER FOR 'SCORE' SUBROUTINES. ≡≡≡≡≡≡≡
	SUBROUTINE SUBR
	COMMON /P/P(1) /PL/PL(1) /INS/ INST(27),BG(60)
	COMMON INUM,IPAR,CNT(27),BT,IREST,DF,DUR(27)
C   INUM=INST#  IPAR=PARAM#  
C   BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
C   IF IREST IS <0, THAT NOTE WILL BE A REST.  
C   INST=INST. NAME,  BG=INSTS' BEGIN TIMES.
C   NOTE #S IN SUBROUTINE: (1-84)  C4=37  FS4=43  C5=49  ETC.
C   F1=86  F15=100 (NO F16!)
 
	DIMENSION A(3), B(3), C(3), KK(27), M(27)
	DATA A/0,2.,1./,  B/0,4.,10./, C/0,-2.,-1./, KA/4/,KB/4/,KC/4/
C 1ST MOTIVE GOES UP 1 STEP, DOWN 1/2 STEP.  'C' IS INVERSION OF 'A'.
 
	K=KK(INUM)
 
	IF(K.NE.0)GO TO 10
	M(INUM)=P(3)
	J=RAND(1.0,3.99)
C PICK A MOTIVE.  1, 2 OR 3.
10	K=K+1
	GO TO (1,2,3)J
1	P(3)=A(K)+M(INUM)
	IF(K.EQ.KA)K=0
4	KK(INUM)=K
C SAVE VALUE OF K FOR NEXT TIME AROUND.
	IF(K.EQ.0)IREST=-1
C LAST 'NOTE' OF EACH MOTIVE WILL BE A REST.
	RETURN
2	P(3)=B(K)+M(INUM)
	IF(K.EQ.KB)K=0
	GO TO 4
3	P(3)=C(K)+M(INUM)
	IF(K.EQ.KC)K=0
	GO TO 4
	END